home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr50 / wbb13.zip / SAMPLEG4.BAS < prev    next >
BASIC Source File  |  1993-06-04  |  6KB  |  263 lines

  1.  
  2. rem
  3. rem This program is just like SAMPLEG3.BAS except that in this
  4. rem one we handle our own screen repainting (ON PAINT GOSUB xxxx)
  5. rem AND we use our own palette.
  6. rem
  7. rem This program is for WINDOWS use only.
  8. rem
  9. rem Notice use of the ON PAINT command.  Please note that any variables
  10. rem you change while handling an ON PAINT command will also be changed
  11. rem in your main program and you can receive an ON PAINT command
  12. rem  A N Y T I M E !!!!!!!  Also notice that we use the function SYSTEM(12)
  13. rem to see if we are the active window and if we are not we DO NOT use
  14. rem the paint command.  Since we are using our own palette, if we were
  15. rem not the active window, Windows can erase our custom colors.  Then
  16. rem the PAINT command might not work correctly since the border color we are
  17. rem looking for might not exist.  Hence we would paint the entire window.
  18. rem
  19.  
  20.    rem windows size 30,9,50,11
  21.  
  22.    REM windows name "Mark's Clock"
  23.  
  24.  
  25.    rem
  26.    rem Before going into graphics mode say we are handling paint.  If we
  27.    rem wait and do this after SCREEN command then a big bitmap would be
  28.    rem created (during SCREEN command) and then deleted (during ON PAINT).
  29.    rem
  30.    on paint gosub 1000
  31.    screen 1000,16
  32.    mode=system(7)
  33.  
  34.    createfont 1,60,0,0,0,0,0,0,0,0,0,0,0,0,""
  35.    createfont 2,14,0,0,0,0,0,0,0,0,0,0,0,0,""
  36.    selectfont 1
  37.    xsize=dlen("00:00:00")
  38.    rem
  39.    rem See if we have written out initialization parameters
  40.    rem
  41.    l=len(dir$("marks.stu"))
  42.    if l>0 then
  43.     open "marks.stu" for input as #1
  44.     input #1,leftx,topy,offset
  45.     close #1
  46.    else
  47.     leftx=0
  48.     topy=0
  49.    end if
  50.  
  51.    rem
  52.    rem size window
  53.    rem
  54.  
  55.    position leftx,topy,xsize+1-(xsize/9),60
  56.  
  57.  
  58.    rem
  59.    rem make background color our own special blend
  60.    rem
  61.    line (0,0)-(xsize+1-(xsize/9),60),4,bf
  62.    color 15,4
  63.    PALETTE 4,65536*255+256*200+150
  64.      rem bright blue + a little green + a smidgeon of red
  65.  
  66.  
  67.    gosub makebuttons
  68.    mouseflag=mouseon
  69.  
  70.  
  71.  
  72.    t$=""
  73.    quartersec=5
  74.  
  75.  
  76. rem
  77. rem Now we enter a perpetual loop to update time
  78. rem
  79.  
  80. 100
  81.    tt$=time$
  82.  
  83.    if left$(tt$,5)<>t$ then
  84.      t$=left$(tt$,5)
  85.      gosub drawhourmin
  86.    end if
  87.  
  88.    sec=val(right$(tt$,2))
  89.    sec=int(sec/15)
  90.    if sec<>quartersec then
  91.      if quartersec=5 then
  92.        for quartersec=0 to sec
  93.      gosub drawsec
  94.        next quartersec
  95.      else
  96.        quartersec=sec
  97.        gosub drawsec
  98.      end if
  99.    end if
  100.  
  101.    rem
  102.    rem check for button push
  103.    rem
  104.    a$=inkey$
  105.    if len(a$)>1 then
  106.     if asc(right$(a$,1))=59 or asc(right$(a$,1))=60 then
  107.      rem + pushed
  108.      if asc(right$(a$,1))=59 then
  109.        offset=offset+1
  110.        if offset>30 then offset=30
  111.      else
  112.        offset=offset-1
  113.        if offset<-30 then offset=-30
  114.      end if
  115.      ix=xsize-((xsize/8)*2)
  116.      iy=40
  117.      ix=ix-10
  118.      iy=iy-10
  119.      line (ix,iy)-(ix+20,iy+20),4,BF
  120.      selectfont 2
  121.      locate iy,ix
  122.      print str$(offset);
  123.      selectfont 1
  124.      gosub drawhourmin
  125.      open "marks.stu" for output as #1
  126.      print #1, x,y,offset
  127.      close #1
  128.     end if
  129.    end if
  130.    goto 100
  131.  
  132.  
  133.  
  134. rem
  135. rem routine to draw hour/min
  136. rem
  137. rem on input tt$ has 5 chars for hour/min
  138. rem
  139.  
  140. drawhourmin:
  141.  
  142.    ttt$=left$(tt$,5)
  143.    if offset<>0 then
  144.      h=val(left$(ttt$,2))
  145.      m=val(right$(ttt$,2))
  146.      m=m+offset
  147.      if m>59 then
  148.        m=m-60
  149.        h=h+1
  150.        if h=24 then h=0
  151.      elseif m<0 then
  152.        m=m+60
  153.        h=h-1
  154.        if h<0 then h=23
  155.      end if
  156.      m$=str$(m)
  157.      l=len(m$)
  158.      m$=right$(m$,l-1)
  159.  
  160.      if len(m$)<2 then m$="0"+m$
  161.      if len(m$)>2 then m$=right$(m$,2)
  162.      h$=str$(h)
  163.      l=len(h$)
  164.      h$=right$(h$,l-1)
  165.      if len(h$)<2 then h$="0"+h$
  166.      if len(h$)>2 then h$=right$(h$,2)
  167.      ttt$=h$+":"+m$
  168.    end if
  169.    locate 0,0
  170.    print ttt$;
  171.    return
  172.  
  173.  
  174. rem
  175. rem draw second
  176. rem
  177. rem quartersec  has 1/4 min
  178. rem
  179.  
  180. drawsec:
  181.  
  182.      x=xsize-((xsize/8)*2)
  183.      y=40
  184.      if quartersec=0 then
  185.      circle (x,y),10,12
  186.      if system(12)=1 then
  187.        paint (x,y),12
  188.      end if
  189.        circle (x,y),10,7,-.01,-3.1416/2
  190.        if system(12)=1 then
  191.      paint (x+2,y-2),7
  192.        end if
  193.      elseif quartersec=1 then
  194.        circle (x,y),10,6,-4.7124,-.01
  195.        if system(12)=1 then
  196.      paint (x+2,y+2),6
  197.        end if
  198.      elseif quartersec=2 then
  199.        circle (x,y),10,5,-3.1416,-4.7124
  200.        if system(12)=1 then
  201.      paint (x-2,y+2),5
  202.        end if
  203.      elseif quartersec=3 then
  204.        circle (x,y),10,3,-3.1416/2,-3.1416
  205.        if system(12)=1 then
  206.      paint (x-2,y-2),3
  207.        end if
  208.        gosub checkposition
  209.      end if
  210.      return
  211.  
  212.  
  213.  
  214. rem
  215. rem check and see if window position has changed.  If so write new
  216. rem position to my initialization file
  217. rem
  218.  
  219. checkposition:
  220.     x=system(8)
  221.     y=system(9)
  222.     if x<>leftx or y<>topy then
  223.       open "marks.stu" for output as #1
  224.       print #1, x,y,offset
  225.       close #1
  226.     end if
  227.     return
  228.  
  229.  
  230. rem
  231. rem We come here when notified by windows to paint the screen
  232. rem
  233. rem We could get a paint command before we have gotten our first
  234. rem time (tt$="").  If so do nothing.
  235. rem
  236.  
  237. 1000
  238.    if tt$="" then return
  239.    line (0,0)-(xsize+1-(xsize/9),60),4,BF
  240.  
  241.    selectfont 1
  242.    gosub drawhourmin
  243.    savequartersec=quartersec
  244.    for quartersec=0 to savequartersec
  245.      gosub drawsec
  246.    next quartersec
  247.    quartersec=savequartersec
  248.    return
  249.  
  250.  
  251.  
  252. makebuttons:
  253.    rem
  254.    rem define buttons
  255.    rem
  256.  
  257.      px=xsize-((xsize/8)*3)+4
  258.      py=10
  259.      CBUTTON "+",1059,0,"Push",0,px+5,py,16,14,7,1
  260.      cbutton "-",1060,0,"Push",0,px+25,py,16,14,7,1
  261.      return
  262.  
  263.